perm filename TEST.QU[C,JRA] blob sn#014380 filedate 1972-11-29 generic text, type T, neo UTF8
00050	(SETQ IBASE 10.)
00100	(DE PICKIT(L N)
00200	(PROG( I J L1)
00300	(SETQ J (ADD1(LENGTH L)))
00500	L1(SETQ I 1)
00600	(SETQ L1 L)
00700	L(COND((NULL L1)(RETURN N))
00750	       ((OR(EQ(CAR L1) N)
00775			(EQ(PLUS(CAR L1) I)(PLUS N J))
00800	           (EQ(DIFFERENCE(CAR L1) I)(DIFFERENCE N J)))(GO AGAIN)))
00900	(SETQ L1(CDR L1))
01000	(SETQ I(ADD1 I))
01050	(GO L)
01100	AGAIN(SETQ N(ADD1 N))
01200	(COND((GREATERP N 8)(RETURN NIL)))
01300	(GO L1)
01400	))
01500	(CDEFUN QUEEN()
01600	"AUX"((ANS NIL)(N 1) M (CONTEXT(PUSH-CONTEXT)))
01700	:L (COND((EQ(LENGTH ANS) 8)(RETURN ANS)))
01750	:LL(PRINT(LIST ANS N))
01800	(CSETQ M(PICKIT ANS N))
01900	(COND(M
01987	(ADD !"(VALUE  ,M ,ANS))
02000	        (CSETQ CONTEXT(PUSH-CONTEXT))
02050	     (CSETQ ANS(APPEND ANS(LIST M)))
02100	        (CSETQ N 1)(GO 'L)))
02200	:LLL(CSETQ CONTEXT(POP-CONTEXT))
02300	(TRY-NEXT(FETCHI !"(VALUE !>N !>ANS)))
02325	(CSETQ N(ADD1 N))
02350	(COND((GREATERP N 8)(GO 'LLL)))(GO 'LL)
02400	)
02500	(QUEEN)